Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/Bonus/Plasmatech/ptscp_examples.exe/%MAINDIR%/Examples/Translation/Delphi/FMain.pas

Pascal/Delphi Source File | 2001-08-31 | 7.8 KB | 250 lines

unit FMain;
{
  Shell Control Pack Examples
  TrDemo - How to apply translations.

  Ensure the Plasmatools directory is in your project or library search path
  and the Lang subdirectory is in place. This demo requires either the DCU
  or Source versions of the Shell Control Pack. This demo won't do translations
  with Delphi 2.

  Delphi 3
  ========
  You can choose to build translated strings directly into the EXE or include
  them in a separate translation DLL.

  To build into the EXE, simply define one of the LANG_ constants in the
  Project|Options|Directories/Conditionals|Conditional defines field.
  See UPTShConsts.pas for a list of valid defines. eg. LANG_DE for German,
  LANG_FR for French and LANG_ES for Spanish.

  To build seperate translation DLLs, just run the build.bat files in the
  D3 directory. TrDemo.de and TrDemo.fr files will be placed with the
  TrDemo.exe. You can then run TrDemo.exe to see the translations (if running
  on the appropriate language version of Windows). Use the TrDemo.exe program
  itself to override automatic translation DLL selection.

  Delphi 2
  ========
  Ensure the .res files under the Plasmatools\Lang directory are built by
  executing the makeres.bat file in the Lang directory.

  Build the translated .res files into your EXE by applying a LANG_ constant to
  the Project|Options|Directories/Conditionals|Conditional defines field.

  Delphi 2 does not natively support translation DLLs. If you are building your
  own Translation DLL, simply include the appropriate .res file in each language
  DLL and set the UPTShConsts.gptshResourceInstance global variable to the
  HInstance of your translation DLL.

  Non-Ansi character sets: A bug in Delphi 2 means popup hints always use the MS
  Sans Serif font - especially useless for double-byte languages like Japanese.
  You can fix this with an Appliation.OnShowHint handler, or change the
  HintWindowClass. This is only a problem in Delphi 2.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Registry, StdCtrls, FPTOpenDlg, ComCtrls, UPTTreeList, UPTShellControls, UPTFrame,
  Menus, FPTFolderBrowseDlg, UPTShellUtils;

type
  TFrmMain = class(TForm)
    PTOpenDlg1: TPTOpenDlg;
    PTSaveDlg1: TPTSaveDlg;
    Label1: TLabel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Test1: TMenuItem;
    Opendialog1: TMenuItem;
    Savedialog1: TMenuItem;
    Folderbrowsedialog1: TMenuItem;
    PTFrame1: TPTFrame;
    LangEdt: TEdit;
    Label2: TLabel;
    PTFrame2: TPTFrame;
    PTFolderBrowseDlg1: TPTFolderBrowseDlg;
    N1: TMenuItem;
    Changelanguage1: TMenuItem;
    Clearoverride1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Opendialog1Click(Sender: TObject);
    procedure Savedialog1Click(Sender: TObject);
    procedure Folderbrowsedialog1Click(Sender: TObject);
    procedure Clearoverride1Click(Sender: TObject);
    procedure Changelanguage1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.DFM}

{$IFDEF VER100}
function GetResourceModuleName(ModuleName: PChar): String; forward;
{$ENDIF}

procedure TFrmMain.FormCreate(Sender: TObject);
begin
{$IFNDEF VER100}
  LangEdt.Text := 'Language modules apply to Delphi 3 only.';
{$ELSE}
  LangEdt.Text := GetResourceModuleName(PChar(ParamStr(0)));
{$ENDIF}
end;

procedure TFrmMain.Opendialog1Click(Sender: TObject);
begin
  PTOpenDlg1.Execute;
end;

procedure TFrmMain.Savedialog1Click(Sender: TObject);
begin
  PTSaveDlg1.Execute;
end;

procedure TFrmMain.Folderbrowsedialog1Click(Sender: TObject);
begin
  PTFolderBrowseDlg1.Execute;
end;

const LOCALE_OVERRIDE_KEY = 'Software\Borland\Delphi\Locales';

procedure TFrmMain.Clearoverride1Click(Sender: TObject);
var r: TRegistry;
begin
  r := TRegistry.Create;
  try
    if r.OpenKey( LOCALE_OVERRIDE_KEY, FALSE ) then
      r.DeleteValue( ParamStr(0) )
    else
      raise Exception.Create( 'Failed' );
    r.CloseKey;
    ShowMessage( 'Restart the application for the change to take effect. ' );
  finally
    r.Free;
  end;
end;

procedure TFrmMain.Changelanguage1Click(Sender: TObject);
var o: TPTOpenDlg;
    r: TRegistry;
    h: THandle;
    s: String;
begin
  o := TPTOpenDlg.Create( self );
  o.Options := [ptofFileMustExist, ptofHideReadOnly, ptofAllowTree, ptofShowHints, ptofOleDrag, ptofOleDrop];
  s := ExtractFileName(ParamStr(0));
  s := Copy(s, 1, Length(s) - Length(ExtractFileExt(s)));
  o.Filter := Format('Translation DLLs (%s.??)|%s.??|All files (*)|*|',[s,s]);
  try
    if o.Execute then
    begin
      r := TRegistry.Create;
      try
        h := LoadLibraryEx( PChar(o.FileName), 0, LOAD_LIBRARY_AS_DATAFILE );
        if (h=0) then
          raise Exception.Create( 'File is not a translation DLL.' )
        else
          FreeLibrary(h);

        if r.OpenKey( LOCALE_OVERRIDE_KEY, TRUE ) then
          r.WriteString( ParamStr(0), Copy(ExtractFileExt(o.FileName), 2, $FF) )
        else
          raise Exception.Create( 'Failed' );
        r.CloseKey;
        ShowMessage( 'Restart the application for the change to take effect. ' );
      finally
        r.Free;
      end;
    end;
  finally
    o.Free;
  end;
end;

procedure TFrmMain.Exit1Click(Sender: TObject);
begin
  Close;
end;


{$IFDEF VER100}

{ This method is not pertitent to the example. It detects which
  language DLL is being used by Delphi 3. We cannot simply do a
  GetModuleFileName(FindResourceHInstance.... since Delphi loads
  resource dlls with the LOAD_LIBRARY_AS_DATAFILE flag. Windows
  rejects calls to GetModuleName of DLLs loaded with this flag. }

function GetResourceModuleName(ModuleName: PChar): String;
var
  FileName: array[0..260] of Char;
  Key: Integer;
  LocaleName, LocaleOverride: array[0..4] of Char;
  Size: Integer;
  P: PChar;
  hinst: THandle;
begin
  GetModuleFileName(0, FileName, SizeOf(FileName)); // Get host appliation name
  LocaleOverride[0] := #0;
  if RegOpenKeyEx(HKEY_CURRENT_USER, LOCALE_OVERRIDE_KEY, 0, KEY_ALL_ACCESS, Key) = 0 then
  try
    Size := SizeOf(LocaleOverride);
    if RegQueryValueEx(Key, FileName, nil, nil, PByte(@LocaleOverride[0]), @Size) <> 0 then
      RegQueryValueEx(Key, '', nil, nil, PByte(@LocaleOverride[0]), @Size);
  finally
    RegCloseKey(Key);
  end;
  lstrcpy(FileName, ModuleName);
  GetLocaleInfo(GetThreadLocale, LOCALE_SABBREVLANGNAME, LocaleName, SizeOf(LocaleName));
  hinst := 0;
  if (FileName[0] <> #0) and ((LocaleName[0] <> #0) or (LocaleOverride[0] <> #0)) then
  begin
    P := PChar(@FileName) + lstrlen(FileName);
    while (P^ <> '.') and (P <> @FileName) do Dec(P);
    if P <> @FileName then
    begin
      Inc(P);
      // First look for a locale registry override
      if LocaleOverride[0] <> #0 then
      begin
        lstrcpy(P, LocaleOverride);
        hinst := LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE);
      end;
      if (hinst = 0) and (LocaleName[0] <> #0) then
      begin
        // Then look for a potential language/country translation
        lstrcpy(P, LocaleName);
        hinst := LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE);
        if hinst = 0 then
        begin
          // Finally look for a language only translation
          LocaleName[2] := #0;
          lstrcpy(P, LocaleName);
          hinst := LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE);
        end;
      end;
    end;
  end;
  if hinst=0 then
    GetModuleFileName( HInstance, FileName, High(Filename) );
  result := ExtractFileName(ShellGetDisplayPathName(Filename));
  FreeLibrary( hinst );
end;

{$ENDIF VER100}

end.